home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 1996 September / Software of the Month Club 1996 September.iso / mac / Software Research Institute-SRI / Business / Alpha ƒ / Tcl / SystemCode / procs.tcl < prev    next >
Encoding:
Text File  |  1996-01-07  |  23.9 KB  |  960 lines  |  [TEXT/ALFA]
  1.  
  2. #==============================================================================
  3. # Load electric alias, rebind tcl file completion for precedence.
  4. proc loadElectricAlias {} {
  5.     global HOME
  6.     uplevel #0 {
  7.         source "$HOME:Tcl:ElectricAlias:electricAlias.tcl"
  8.     }
  9.     message "ElectricAlias loaded."
  10.     bind '\t' tclFileCompletion "Shel"
  11.     enableMenuItem -m install "Electric Alias" off
  12. }
  13.  
  14. proc debug {} {
  15.     uplevel #0 {
  16.         set debugging 1
  17.     }
  18. }
  19.  
  20.  
  21. proc normalLeftBracket {} {
  22.     insertText "\{"
  23. }
  24. proc normalRightBracket {} {
  25.     insertText "\}"
  26. }
  27. bind '\[' <zs>  normalLeftBracket
  28. bind '\]' <zs>  normalRightBracket
  29.             
  30. # Select the next or current word. If word already selected, will go to next.
  31. proc hiliteWord {} {
  32.     if {[getPos]!=[selEnd]}    forwardChar
  33.     forwardWord
  34.     set start [getPos]
  35.     backwardWord
  36.     select $start [getPos]
  37. }
  38.  
  39. bind 'h' <z> hiliteWord
  40.  
  41. #================================================================================
  42. # Mode variables
  43. #================================================================================
  44. # For mark stack.
  45. set markName 0
  46. set markStack ""
  47.  
  48. # mapping of windows to current modes.
  49. set winModes("") ""
  50.  
  51. # making vars local to windows
  52. # 'incomingVars' used to hold old var values that have been overwritten in current window
  53.  
  54. #================================================================================
  55. # Handle 'flag' and 'var' menu selections.
  56. #================================================================================
  57. proc editFlag {menu item} {
  58.     global $item incomingVars localVars modifiedVars tcl_var_procs
  59.  
  60.     if {[regexp {\? (.*)} $item dummy var]} {
  61.         alphaHelp
  62.         eval select [search -f 1 -r 1 "^$var"]
  63.         return
  64.     }
  65.     lappend modifiedVars $item
  66.     set val [expr ([set $item]-1)*-1]
  67.     markMenuItem $menu $item [expr ($val)?"on":"off"]
  68.     set $item $val
  69.  
  70.     if {[info exists tcl_var_procs($item)]} {
  71.         $tcl_var_procs($item) $item
  72.     }
  73. }
  74.  
  75. proc editVar {menu item} {
  76.     global $item incomingVars localVars modifiedVars
  77.  
  78.     if {[regexp {\? (.*)} $item dummy var]} {
  79.         alphaHelp
  80.         eval select [search -f 1 -r 1 "^$var"]
  81.         return
  82.     }
  83.     lappend modifiedVars $item
  84.     append prmpt "New Value of " $item ": "
  85.     if ![catch {prompt $prmpt [set $item]} res] {
  86.         set $item $res
  87.     }
  88. }
  89.  
  90.  
  91.  
  92.  
  93. #================================================================================
  94.  
  95. # Instantiate a global variable to the path of a file (usually an app). As a
  96. # side-effect, make the instantiation permanent.
  97. proc addAppPath {name var} {
  98.     global $var modifiedVars
  99.     
  100.     if {$name == "CodeWarrior Compiler"} {
  101.         alertnote {Please locate the compiler via menu item "Mode:App Paths:CodeWarrior Compiler"}
  102.         error ""
  103.     } elseif {$name == "CodeWarrior Debugger"} {
  104.         alertnote {Please locate the debugger via menu item "Mode:App Paths:CodeWarrior Debugger"}
  105.         error ""
  106.     }
  107.         
  108.     set $var [getfile "Find '$name' app:"]
  109.     lappend modifiedVars $var
  110. }
  111.  
  112.  
  113. proc getFileSig {f} {
  114.     getFileInfo $f arr
  115.     return $arr(creator)
  116. }
  117.  
  118. proc getFileType {f} {
  119.     getFileInfo $f arr
  120.     return $arr(type)
  121. }
  122.  
  123.  
  124. # Look for given app sig in active processes. If not there, try to 
  125. # launch with 'path' prompting for 'path' if necessary.
  126. # Return the real name of the app. Don't switch.
  127.  
  128. # Slightly modified version of 'checkRunning' that looks for any of a
  129. # list of running apps.  The name of the app is returned. 
  130. # 
  131. proc checkRunning {prompt sigs path {in_front 1}} {
  132.     global $path
  133.  
  134.     # See if a process w/ any of the acceptable sigs already running.
  135.     # If so, use it, whether it's the one specified by $path or not.
  136.     #
  137.     foreach proc [processes] {
  138.         # if a running app has the correct sig, ...
  139.         if {[lsearch -exact $sigs [lindex $proc 1]] >= 0} {
  140.             # ...then return its name.
  141.             return [lindex $proc 0]
  142.         }
  143.     }
  144.  
  145.     # If the path variable or the file it references don't exist,
  146.     # or if its sig isn't one that we expect, then prompt the user 
  147.     # to locate the app.
  148.     #
  149.     if {![info exists $path] || ![file exists [set $path]] 
  150.              || [lsearch -exact $sigs [getFileSig [set $path]]] < 0} {
  151.         if {[catch {addAppPath $prompt $path}]} return
  152.     }
  153.  
  154.     # Check that the user's choice has an acceptable sig
  155.     if {[lsearch -exact $sigs [getFileSig [set $path]]] < 0} {
  156.         unset $path
  157.         message "Inappropriate file chosen"
  158.         return {} 
  159.     }
  160.     
  161.     # Launch the app
  162.     if {$in_front} {
  163.         if {[catch {launch -f [set $path]}]} {
  164.             error "Problem with launching file (out of memory?)"
  165.         }
  166.     } else {
  167.         if {[catch {launch [set $path]}]} {
  168.             error "Problem with launching file (out of memory?)"
  169.         }
  170.     }        
  171.     
  172.     # Return the name of the chosen application
  173.     return [file tail [set $path]]
  174. }
  175.  
  176.  
  177. #================================================================================
  178. # Excalibur is the only Mac spell-checker that I know of which will handle LaTeX as
  179. # well as ordinary text.
  180.  
  181.  
  182. proc spellcheckWindow {} {
  183.     global excaliburPath resumeRevert
  184.  
  185.     catch {checkRunning Excalibur XCLB excaliburPath} name
  186.  
  187.     if {[winDirty]} {
  188.         if {[askyesno "Save '[lindex [winNames] 0]'?"] == "yes"} {
  189.             save
  190.         }
  191.     }
  192.     sendOpenEvent noReply $name [lindex [winNames -f] 0]
  193.     switchTo $name
  194.     set resumeRevert 1
  195. }
  196.  
  197. proc spellcheckSelection {} {
  198.     global excaliburPath 
  199.  
  200.     catch {checkRunning Excalibur XCLB excaliburPath} name
  201.  
  202.     if {[getPos] == [selEnd]} {
  203.         beep
  204.         message "No selection"
  205.         return;
  206.     }
  207.     copy
  208.     switchTo $name
  209. }
  210.  
  211. #================================================================================
  212.  
  213.  
  214. proc alphaHelp {} {
  215.     global HOME alphaLite
  216.     if $alphaLite {
  217.         edit -r "$HOME:Help:Quick Start"
  218.     } else {
  219.         edit -r "$HOME:Help:Manual"
  220.     }
  221. }
  222.  
  223.  
  224. proc tclHelp {} {
  225.     global HOME
  226.     edit -r "$HOME:Help:Tcl Commands"
  227. }
  228.  
  229.  
  230. proc dividingLine {} {
  231.     insertText "===============================================================================\r"
  232. }
  233. bind 'l' <C> dividingLine
  234.  
  235. proc texDividingLine {} {
  236.     insertText "%===============================================================================\r"
  237. }
  238. bind 'l' <C> texDividingLine TeX
  239.  
  240. proc cDividingLine {} {
  241.     insertText "//===============================================================================\r"
  242. }
  243. bind 'l' <C> cDividingLine C
  244. bind 'l' <C> cDividingLine C++
  245.  
  246. proc tclDividingLine {} {
  247.     insertText "#===============================================================================\r"
  248. }
  249. bind 'l' <C> tclDividingLine Tcl
  250.  
  251.  
  252. #================================================================================
  253.  
  254. if {![string length [info commands oldCd]]} {
  255.     rename cd oldCd
  256. }
  257.  
  258. proc cd args {
  259.     global HOME
  260.     if {[llength $args]} {
  261.         oldCd [string trim [eval list $args] "        \{\}"]
  262.     } else {
  263.         oldCd $HOME
  264.     }
  265. }
  266.  
  267.  
  268.  
  269. #############################################################################
  270. #  List the name and value of each element of the array $arrName.
  271. #  (Convenient to use as a shell command.)
  272. #
  273. #  Note: it's slower to insert the lines one-by-one like this, but 
  274. #  assembling everything in $lines before inserting can seriously crash Alpha
  275. #  if the result is too big.  (Trying to list the contents of $auto_index()
  276. #  will do it.)  This method seems to be more robust.
  277. #
  278. proc listArray {arrName} {
  279.     global $arrName
  280.     set lines {}
  281.     if {![catch {info vars $arrName}]} {
  282.         foreach nm [array names $arrName] {
  283.             set val [expr \$$arrName\($nm\)]
  284.             append lines "\r\"$nm\"\t\{$val\}"
  285.         }
  286.         insertText $lines
  287.     } else {
  288.         alertnote "\"$arrName\" doesn't exist in this context"
  289.     }
  290. }
  291.  
  292.  
  293.  
  294. #================================================================================
  295.     
  296. proc selectParagraph {} {
  297.     set pos [getPos]
  298.     set start [paraStart $pos] 
  299.     set finish [paraFinish $pos]
  300.     goto $start
  301.     select $start $finish
  302. }
  303.  
  304. # wrapText ==  getText ; breakIntoLines ; replaceText
  305. # Remove text from window, transform (join, del-ws), insert back into window.
  306. proc fillTextByPar {from to} {
  307.     set text [getText $from $to]
  308.     regsub -all "\r(\[ \t\]*\r)+" $text "\r\r\r" text
  309.     regsub -all "(\[^\r\])\r" $text "\\1 " text
  310.     regsub -all "\[ \t\]+" $text " " text
  311.     return [breakIntoLines $text]
  312. }
  313.  
  314. proc fillRegionByPar {{start -1} {finish -1}} {
  315. #    # if {[getPos] == [selEnd]} { return}
  316.     if {($start < 0) || ($finish < 0)} {
  317.         set start [lineStart [getPos]]
  318.         set finish [selEnd] }
  319.     if {$start >= $finish} return
  320.     goto $start
  321.     set text [fillTextByPar $start $finish]
  322.     replaceText $start $finish $text "\r"
  323. }
  324.     
  325. #
  326. # join Lines in region -- if no optional args, use selection
  327. #
  328. proc joinRegion {{from -1} {to -1}} {
  329.     if {($from < 0) || ($to < 0)} {    set from [getPos] ; set to [selEnd] }
  330.     if {$from >= $to} return
  331.     set text [getText $from $to]
  332.     regsub -all "\r(\[ \t\]*\r)+" $text "\r\r\r" text
  333.     regsub -all "(\[^\r\])\r" $text "\\1 " text
  334.     replaceText $from $to $text "\r"
  335. }
  336. # WARNING:    regsub ^$ refers to string endpts (not lines)
  337. # FUTURE:    filterLines like perl:
  338. #    replaceText[apply_to_all(cmd,split [getText [getPos] [selEnd]] "\r")]
  339. # OR:    replaceInRegion: dup_\r, $=>\r ??
  340. #
  341.  
  342.  
  343. #
  344. # Remove text from window, transform (delete dup ws), insert back into window.
  345. #
  346. # inputs: message, alertnote, askyesno, listpick, prompt KILLS SELECTION.
  347. # search: bnds = search -forward -regExpr -ignoreCase -matchWords -noabort 
  348. #        -l limit pat pos
  349. # 
  350. proc regsubInRegion {from to srch repl} {
  351.     if {![string length $srch]} return
  352.     if {$from >= $to} return
  353.     set text [getText $from $to]
  354.     regsub -all "$srch" $text "$repl" text
  355.     replaceText $from $to $text
  356. }
  357. #    while {($pos < $to) &&
  358. #          ![catch {search -s -f 1 -r 1 -i 1 -m 0 "$srch" $pos} mtch]} {
  359. #        set mbeg [lindex $mtch 0]
  360. #        set pos [lindex $mtch 1]
  361. #        replaceText $mbeg $pos $repl }
  362.  
  363. #proc backSlashSub {arg} { eval [concat return "\"$arg\""] }
  364.  
  365. proc backSlashSub {arg} {
  366.     regsub -all {\\} $arg {\\\\} arg
  367.     regsub -all {\[} $arg {\\[} arg
  368.     regsub -all {\]} $arg {\\]} arg
  369.     eval [concat return "\"$arg\""]
  370. }
  371.  
  372. proc replaceInRegion {} {
  373.     if [catch {prompt "Search RegExpr:" ""} srch] return
  374.     if [catch {prompt "Replace String:" ""} repl] return
  375.     if {![string length $srch]} return
  376.     regsubInRegion [getPos] [selEnd] \
  377.         [backSlashSub "$srch"] [backSlashSub "$repl"]
  378. }
  379.  
  380. #
  381. # Apply command to each line (or paragraph) in selection ;
  382. #    if no cmd arg then prompts for it
  383. #
  384. proc filterLines {{cmd 0} {parunit 0}} {
  385.     if {$cmd == 0} {
  386.       if {[catch { prompt "Line-filter command: " "" } cmd]} { return } }
  387.     if {![string length $cmd]} return
  388.     set unitStart lineStart
  389.     set unitEnd nextLineStart
  390.     if {$parunit} {
  391.         set unitStart paraStart
  392.         set unitEnd paraFinish }
  393.     set pos [$unitStart [getPos]]
  394.     set finish [selEnd]
  395.     if {$pos >= $finish} return
  396.     goto $pos
  397.     createTMark "filterLend" $finish
  398.     set next [$unitEnd $pos]
  399.     while {(($next > $pos) && ($pos < $finish))} {
  400.         goto [expr $next-1]
  401.         createTMark "filterLnext" $next
  402.         setMark
  403.         goto $pos
  404.         markHilite
  405.         if {[catch [list uplevel #0 "$cmd"] retval]} {
  406.             select $pos $finish
  407.             alertnote $retval
  408.             return
  409.         }
  410.         if {$next==$finish} break
  411.         set ind [lsearch -regexp [lindex [getTMarks] 0] "filterLend.*"]
  412.         set finish [lindex [lindex [lindex [getTMarks] 0] $ind] 2]
  413.         gotoTMark "filterLnext"
  414.         set pos [$unitStart [getPos]]
  415.         set next [$unitEnd $pos]
  416.     }
  417.     removeTMark "filterLend"
  418.     removeTMark "filterLnext"
  419. }
  420.  
  421.  
  422. proc filterParagraphs {{cmd 0}} { filterLines $cmd 1 }
  423.  
  424. # WARNING: deselecting sets the mark to selEnd
  425. proc sortParagraphs {{from -1} {to -1}} {
  426.     if {($from < 0) || ($to < 0)} {    set from [getPos] ; set to [selEnd] }
  427.     if {$from >= $to} return
  428.     joinRegion {$from $to}
  429.     select [getPos] [nextLineStart [getMark]]
  430.     sortLines
  431.     select [getPos] [getPos]
  432.     regsubInRegion [getPos] [getMark] "\r" "\r\r" 
  433.     wrapRegion
  434. }
  435.  
  436. #
  437. # Sample
  438. #
  439. proc filterRegion {{from -1} {to -1} {cmd 0} {newwin 0}} {
  440.     if {$cmd == 0} {
  441.       if {[catch { prompt "Eval command: " "" } cmd]} { return }
  442.     }
  443.     if {![string length $cmd]} return
  444.     if {($from < 0) || ($to < 0)} {    set from [getPos] ; set to [selEnd] }
  445.     if {$from >= $to} return
  446.     set pos [getPos]
  447.     set text [getText $from $to]
  448.     set text [$cmd $text]
  449.     replaceText $from $to $text "\r"
  450.     goto $pos
  451. }
  452.  
  453.  
  454. #
  455. set lastEvaled ""
  456. proc evaluate {} {
  457.     global lastEvaled
  458.     if {[string length $lastEvaled]} {
  459.         set p "M-x ($lastEvaled): "
  460.     } else {
  461.         set p "M-x: "
  462.     }
  463.     if {[catch {statusPrompt $p} text]} {return}
  464.     if {![string length $text]} {set text $lastEvaled}
  465.     $text
  466.     set lastEvaled $text
  467. }
  468.  
  469.  
  470. # First, define macros to bypass the electric braces.
  471. proc ordLeftBrace {} {
  472.     insertText "        \{"
  473. }
  474. bind {'['} <cs> ordLeftBrace
  475.  
  476. proc ordRightBrace {} {
  477.     insertText "\}"
  478.     blink [matchIt "\}" [expr [getPos]-1]]
  479. }
  480. bind {']'} <cs> ordRightBrace
  481.     
  482. proc quoteWord {} {
  483.     backwardWord
  484.     insertText "'"
  485.     forwardWord
  486.     insertText "'"
  487. }
  488. bind ''' <z> quoteWord
  489.  
  490. #================================================================================
  491.  
  492. proc tomac {fname} {
  493.     set fd [open $fname "r"]
  494.     set text [read $fd]
  495.     close $fd
  496.     set fd [open $fname "w"]
  497.     regsub "\n" $text "\r" text
  498.     puts -nonewline $fd $text
  499.     close $fd
  500. }
  501.  
  502. proc tounix {fname} {
  503.     set fd [open $fname "r"]
  504.     set text [read $fd]
  505.     close $fd
  506.     set fd [open $fname "w"]
  507.     regsub "\r" $text "\n" text
  508.     puts -nonewline $fd $text
  509.     close $fd
  510. }
  511.  
  512.  
  513. proc cat args {
  514.     set files ""
  515.     foreach a $args {
  516.         foreach f [glob $a] {
  517.             lappend files $f
  518.         }
  519.     }
  520.     foreach f $files {
  521.         append text "==============<$f>==============\r"
  522.         set fd [open $f "r"]
  523.         append text "[read $fd]\r\r"
  524.         close $fd
  525.     }
  526.     return $text
  527. }
  528.  
  529. proc catto args {
  530.     set len [llength $args]
  531.     set to [lindex $args [expr $len -1]]
  532.     set args [lrange $args 0 [expr $len -2]]
  533.  
  534.     set files ""
  535.     foreach a $args {
  536.         foreach f [glob $a] {
  537.             lappend files $f
  538.         }
  539.     }
  540.     foreach f $files {
  541.         append text "==============<$f>==============\r"
  542.         set fd [open $f "r"]
  543.         append text "[read $fd]\r\r"
  544.         close $fd
  545.     }
  546.  
  547.     set dfile $to
  548.     if {[file exists $dfile]} {
  549.         set fid [open $dfile "a"]
  550.     } else {
  551.         set fid [open $dfile "w"]
  552.     }
  553.     puts $fid $text
  554.     close $fid
  555. }
  556.  
  557.  
  558. ##############################################################################
  559. #  To be used in the windows created by "matchingLines" or by batch searches.
  560. #
  561. #  With the cursor positioned in a line corrsponding to a match, 
  562. #  go back and select the line in the original file that 
  563. #  generated this match.  (Like emacs 'Occur' functionality)
  564. #
  565. proc gotoMatch {} {
  566.     if {[string match "*MAILBOX*" [lindex [winNames] 0]]} {
  567.         mailGotoMatch
  568.         return
  569.     }
  570.     global tileHeight tileWidth tileTop tileLeft tileHeight errorHeight errorDisp tileMargin
  571.     set errorDisp [expr (2 * ($tileHeight - $tileMargin)) / 3]
  572.     set text [getText [lineStart [getPos]] [expr [nextLineStart [getPos]] - 1]]
  573.     set ind1 [string first "░" $text]
  574.     set ind2 [string last "░" $text]
  575.     if {$ind1 == $ind2} {
  576.         set fname [string trim [string range $text $ind1 end] {░}]
  577.         set msg ""
  578.     } else {
  579.         set fname [string trim [string range $text $ind1 $ind2] {░}]
  580.         set msg [string trim [string range $text $ind2 end] {░}]
  581.     }
  582.     
  583.     set top $tileTop
  584.     set geo [getGeometry]
  585.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) || ([lindex $geo 3] != $errorHeight) } {
  586.         moveWin $tileLeft $top
  587.         sizeWin $tileWidth $errorHeight
  588.     }
  589.     set mar $tileMargin
  590.     incr top [expr $errorHeight + $mar]
  591.     if {[expr {[lsearch [winNames -f] "*$fname"] >= 0}]} {
  592.         if {[string match ":*" $fname]} {
  593.             set fname [file tail $fname]
  594.         }
  595.         bringToFront $fname
  596.         set geo [getGeometry]
  597.         if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) || ([lindex $geo 2] != $tileWidth) || ([lindex $geo 3] != $errorDisp) } {
  598.             sizeWin $tileWidth $errorDisp
  599.             moveWin $tileLeft $top
  600.         }
  601.     } elseif {[file exists $fname]} {
  602.         edit -g $tileLeft $top $tileWidth $errorDisp $fname
  603.     } else {
  604.         if {![string match "*Link*" [getText 0 [nextLineStart 0]]]} {
  605.             alertnote "File \" $fname \" not found." 
  606.         }
  607.         return
  608.     }
  609.     if {[regexp {Line ([0-9]+):} $text dummy line]} {
  610.         set pos [rowColToPos $line 0]
  611.         select $pos [nextLineStart $pos]
  612.     }
  613.     message $msg
  614. }
  615. bind 'c' <Cz>        gotoMatch
  616.  
  617.  
  618. #================================================================================
  619.  
  620. proc prevIntro {} {
  621.     set res [search -s -f 0 -r 0 {== } [getPos]]
  622.     display [lineStart [expr [lineStart [lindex $res 0]] - 1]]
  623. }
  624.  
  625. proc nextIntro {} {
  626.     set res [search -s -f 1 -r 0 {== } [getPos]]
  627.     set res [lindex $res 1]
  628.     set res [search -s -f 1 -r 0 {== } $res]
  629.     display [lineStart [expr [lineStart [lindex $res 0]] - 1]]
  630. }
  631.  
  632. #================================================================================
  633.  
  634. proc searchStart {} {
  635.     global search_start
  636.     select [getPos]
  637.     setMark
  638.     if {[catch {goto $search_start}]} {message "No previous search"}
  639. }
  640.  
  641. #================================================================================
  642.  
  643.  
  644. proc listBindings {} {
  645.     new -n {* Key Bindings *}
  646.     insertText [bindingList]
  647.  
  648.     goto 0
  649.     setWinInfo dirty 0
  650.     setWinInfo read-only 1
  651. }
  652.  
  653.  
  654. proc listFunctions {} {
  655.     global winModes
  656.     new -n {* Functions *}
  657.     insertText "===\r\tCommand-double-click on a function to see its definition\r===\r\r" [join [lsort -ignore [info commands]] "\r"] "\r"
  658.     goto 0
  659.     setWinInfo dirty 0
  660.     changeMode [set winModes([lindex [winNames] 0]) Tcl]
  661. }
  662.  
  663.  
  664. #================================================================================
  665.  
  666. proc printArray {arr} {
  667.     global $arr
  668.         foreach n [array names $arr] {
  669.         append text "$n '[set ${arr}($n)]'\r"
  670.     }
  671.     return [string trim $text "\r"]
  672. }
  673.  
  674. #================================================================================
  675.  
  676.  
  677. proc doATab {} {
  678.     global mode
  679.     global ${mode}modeVars
  680.     if {[info exists ${mode}modeVars] && ![set ${mode}modeVars(electricTab)] || [regexp {[^ \t]} [getText [lineStart [getPos]] [getPos]]]} {
  681.         if {[getPos] != [selEnd]} {
  682.             replaceText [getPos] [selEnd] "\t"
  683.         } else {
  684.             insertText "\t"
  685.         }
  686.     } else {
  687.         indentLine
  688.     }
  689. }
  690.  
  691. #     set ptext [getText [lindex $lst 0] [nextLineStart [lindex $lst 0]]]
  692. #     regsub -all {[^(]} $ptext {} one
  693. #     regsub -all {[^)]} $ptext {} two
  694. #     if {[string length $one] > [string length $two]} {
  695. #         regexp {[^(]*\(} $ptext blah
  696. #         regsub -all {[^    ]} $blah { } lwhite
  697. #     } elseif {($nextC == "\{")} {
  698. #         append lwhite "\t"
  699. #     }
  700.  
  701. # proc indentLine {} {
  702. #     global mode
  703. #     
  704. #     set beg [lineStart [getPos]]
  705. # 
  706. #     set lst [search -s -f 0 -r 1 -i 0 {^[ \t]*[^ \t\r]} [expr $beg-1]]
  707. #     set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
  708. #     set nextC [lookAt [expr [nextLineStart [lindex $lst 1]] - 2]]
  709. # 
  710. #     if {($nextC == "\{")} {
  711. #         append lwhite "\t"
  712. #     } elseif {$nextC == ":"} {
  713. #         set lwhite "[string range $lwhite 0 [expr [string length $lwhite]-3]]\t"
  714. #     }
  715. #         
  716. #     set text [getText $beg [nextLineStart $beg]]
  717. #     regexp {^[ \t]*} $text white
  718. #     set len [string length $white]
  719. #     set nextC [lookAt [expr $beg + $len]]
  720. #     if {$nextC == "\}"} {
  721. #         set lwhite [string range $lwhite 0 [expr [string length $lwhite] - 2]]
  722. #     }
  723. #     
  724. #     global ${mode}modeVars
  725. #     if {[string match "*:\r" $text] && [info exists ${mode}modeVars(elecColon)] && [set ${mode}modeVars(elecColon)]} {
  726. #         if {[string index $lwhite 0] == "\t"} {
  727. #             set lwhite "[string range $lwhite 1 [expr [string length $lwhite] - 1]]  "
  728. #         }
  729. #     }
  730. # 
  731. #     if {$white != $lwhite} {
  732. #         replaceText $beg [expr $beg + $len] $lwhite
  733. #     }
  734. #     goto [expr $beg + [string length $lwhite]]
  735. # }
  736.  
  737.  
  738. proc indentRegion {} {
  739.     set from [lindex [posToRowCol [getPos]] 0]
  740.     set to [lindex [posToRowCol [selEnd]] 0]
  741.     select [getPos]
  742.     while {$from <= $to} {
  743.         goto [rowColToPos $from 0]
  744.         indentLine
  745.         incr from
  746.     }
  747. }
  748.  
  749. #================================================================================
  750.  
  751. proc sPrompt {msg def} {
  752.     global useStatusBar
  753.     if {!$useStatusBar} {return [prompt $msg $def]}
  754.     if {[catch {statusPrompt "$msg ($def): "} ans]} {
  755.         error "cancel"
  756.     }
  757.     if {![string length $ans]} {return $def}
  758.     return $ans
  759. }
  760.  
  761. #================================================================================
  762. proc quoteChar {} {
  763.     message "Literal keystroke to be inserted:"
  764.     insertText [getChar]
  765. }
  766. #===============================================================================
  767.  
  768. proc saveACopyAs {} {
  769.     if {[file exists [set nm [lindex [winNames -f] 0]]]} {
  770.         set nm2 [putfile "Save a copy as:" [file tail $nm]]
  771.         cp $nm $nm2
  772.     }
  773. }
  774. #===============================================================================
  775. proc removeDups {l} {
  776.     foreach f $l {
  777.         set silly($f) 1
  778.     }
  779.     if {[info exists silly]} {
  780.         return [array names silly]
  781.     }
  782. }
  783.             
  784.  
  785. #===============================================================================
  786.  
  787. proc printHeaderProc {} {
  788.     global printHeader printHeaderTime printHeaderFullPath
  789.     
  790.     if {!$printHeader} return ""
  791.     
  792.     if {$printHeaderFullPath} {
  793.         set text [lindex [winNames -f] 0]
  794.     } else {
  795.         set text [lindex [winNames] 0]
  796.     }
  797.     
  798.     if {$printHeaderTime} {
  799.         append text "      [join [mtime [now] short]]"
  800.     }
  801. }
  802.  
  803. #===============================================================================
  804.  
  805. proc toggleNumLock {} {
  806.     global numLock modifiedVars
  807.     
  808.     set numLock [expr -1 * ($numLock - 1)]
  809.     lappend modifiedVars numLock
  810. }
  811.  
  812. #===============================================================================
  813.  
  814. proc register {} {
  815.     global HOME
  816. #    edit -r "$HOME:Help:Registering"
  817.     launch -f "$HOME:Register 1.1.5 Keleher"
  818. }
  819.  
  820. #===============================================================================
  821. # Useful for -command flag of 'lsort'.
  822. proc sortByTail {one two} {
  823.     string compare [file tail $one] [file tail $two]
  824. }
  825.  
  826.  
  827. #===============================================================================
  828.  
  829. proc cmdDoubleClick {{from -1} {to -1} {shift 0} {option 0} {control 0}} {
  830.     global  mode
  831.     
  832.     if {[string length [set whe [expandURL]]]} {
  833.         sendUrl [getSelect]
  834.     } else {
  835.         if {$from < 0} {
  836.             set from [getPos]
  837.             set to [selEnd]
  838.             if {$from == $to} {
  839.                 message "No selection"
  840.                 return
  841.             }
  842.         }
  843.         
  844.         if {[string length [info commands ${mode}DblClick]]} {
  845.             if {[llength [info args ${mode}DblClick]] == 2} {
  846.                 ${mode}DblClick $from $to
  847.             } else {
  848.                 ${mode}DblClick $from $to $shift $option $control
  849.             }
  850.         } else {
  851.             message "No docs"
  852.         }
  853.     }    
  854. }
  855.  
  856. #===============================================================================
  857.  
  858.  
  859. proc editMark {fname mname args} {
  860.     if {[set pos [lsearch [winNames -f] "*$fname*"]] >= 0}  {
  861.         bringToFront [lindex [winNames -f] $pos]
  862.     } else {
  863.         if {[lsearch $args {-r}] >= 0} {
  864.             edit -r "$fname"
  865.         } else {
  866.             edit "$fname"
  867.         }
  868.     }
  869.     if {[lsearch [getNamedMarks -n] $mname] < 0} {
  870.         global    mode
  871.         ${mode}MarkFile
  872.     } 
  873.     gotoMark $mname
  874. }
  875.  
  876.  
  877. proc winDirty {} {
  878.     getWinInfo arr
  879.     return $arr(dirty)
  880. }
  881.  
  882.  
  883. #===============================================================================
  884.  
  885. proc lreverse {l} {
  886.     if {[llength $l] > 1} {
  887.         set first [lindex $l 0]
  888.         set l [lreverse [lrange $l 1 end]]
  889.         lappend l $first
  890.     }
  891.     return $l
  892. }
  893.  
  894.     
  895. #===============================================================================
  896.  
  897.  
  898. set {patternLibrary(Pascal to C Comments)}      { {\{([^\}]*)\}}    {/* \1 */}     }
  899. set {patternLibrary(C++ to C Comments)}            { {//(.*)}            {/* \1 */}     }
  900. set {patternLibrary(Space Runs to Tabs)}        { { +}                {\t}         }
  901.  
  902.  
  903.  
  904. proc getPatternLibrary {} {
  905.     global patternLibrary
  906.     
  907.     foreach nm [array names patternLibrary] {
  908.         lappend nms [concat [list $nm] $patternLibrary($nm)]
  909.     }
  910.     return $nms
  911. }
  912.  
  913. proc rememberPatternHook {search replace} {
  914.     global patternLibrary
  915.     if {[catch {set name [prompt "New pattern's name?" ""]}]} {
  916.         return ""
  917.     }
  918.     addArrDef patternLibrary $name [list $search $replace]
  919.     set patternLibrary($name) [list $search $replace]
  920.     return $name
  921. }
  922.  
  923. proc deletePatternHook {} {
  924.     global patternLibrary
  925.     
  926.     
  927.     set temp [list prompt "Delete which pattern?" [lindex [array names patternLibrary] 0] "Pats:"]
  928.     set name [eval [concat $temp [array names patternLibrary]]]
  929.     removeArrDef patternLibrary $name
  930.     unset patternLibrary($name)
  931. }
  932.  
  933. #===============================================================================
  934. # Support for Peter Gontier's 'ClickWarrior' (Doesn't work for 68k).
  935. #===============================================================================
  936.  
  937. eventHandler ALFA CWOF clickHandler
  938.  
  939. proc clickHandler {msg} {
  940.     global HOME ALPHA dum CODEWarrior CWCLASS
  941.     switchTo $ALPHA
  942.     checkCw
  943.     if {[regexp {╥(.*)╙.*╟.*╚.*╟(.*)╚.*╟(.*)╚} $msg dummy fname find sind]} {
  944.         set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GFil "----" "long(╟0000$find╚)" Segm "long($sind)"]
  945.         if {[regexp {FTxt} $res]} {
  946.             regexp {╟(.*)╚} $res dummy spec
  947.             set f [specToPathName $spec]
  948.             edit $f
  949.         }
  950.     }
  951. }
  952.  
  953. #===============================================================================
  954. proc quickFind {} {isearch}
  955. proc reverseQuickFind {} {rsearch}
  956.  
  957. proc pushPosition {} {pushMark}
  958. proc popPosition {} {popMark}
  959. #===============================================================================
  960.